Light ROM 1/LIGHT-ROM 1 (Amiga Library Services)(1994).iso/ffdisks/d949.lha/BBBBS/BBBBS65.lha/rexx/bbsDoors.rexx

OS/2 REXX Batch file | 1993-09-17 | 5KB | 224 lines

/* $VER: bbsDoors.rexx 6.3 (17.9.93)
Originally called Jump.rexx by Matt English 9-30-92
Alterations by Richard Lee Stockton 5 Aug 93, 17 Sep 93

This is a utility for BBBBS sysops to use rexxDoors offline.
FREELY DISTRIBUTABLE as long as no-one makes any money on it,
this notice remains, and the credits at the main menu remain.
*/

OPTIONS FAILAT 999999

/* Open the support library if it is not already open. */
if ~show('L',"rexxsupport.library") THEN
    CALL addlib('rexxsupport.library',0,-30,0)

if ~showlist('p','QuickSortPort') then do
   ADDRESS COMMAND "run quicksort >NIL:"
   do i=1 to 10
      if ~showlist('p','QuickSortPort') then CALL delay 20
      else leave i
   END
   if showlist('p','QuickSortPort') then CALL addlib('QuickSortPort',-30)
END

name=''
figarg='s:CONFIG.BBS'
IF ~EXISTS(figarg) THEN figarg='BBS:BBS_TEXT/CONFIG.BBS'
x=OPEN(f,figarg,'R')
IF x=0 THEN
  DO
    SAY 's:CONFIG.BBS and BBS:BBS/CONFIG.BBS are both missing!'
    EXIT(20)
  END
lynes.=''
DO i=1 TO 6
  lynes.i=READLN(f)
END
CALL CLOSE(f)

compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
sysop  =WORD(lynes.2,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
  DO
    SAY bbspath 'does not exist!'
    CALL SETCLIP('BBS_STAT')
    EXIT(20)
  END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
CALL SETCLIP('BBS_path',bbspath)
CALL PRAGMA('D',bbspath'rexxDoors')

def='';  /* default */
pen0='';  pen1='';  pen2='';  pen3=''
pen4='';  pen5='';  pen6='';  pen7=''
bak0='';  bak1='';  bak2='';  bak3=''
bak4='';  bak5='';  bak6='';  bak7=''

SAY
SAY'                       bbsDoors.rexx'
SAY'               Original by Matt English 9-30-92'
SAY'       Alterations for BBBBS 6.3 by RLS 9-17-93'
SAY
SAY
options prompt' Are you 'sysop' ? Y or n > '
pull answer
if answer='Y' | answer='' then name=sysop
else DO
  SAY
  options prompt' Please enter your name > '
  pull response
  response=strip(upper(response))
  response=translate(response,'_',' ')
  if response='' then CALL bye
  file=bbspath'lists/Users'
  CALL open(list,file,'r')
  match=0
  do until match=1
   nameline=readln(list)
   if eof(list) then do
    CALL close(list)
    CALL ok
    END
   do i=1 to 3
    testname=word(nameline,i)
    if testname=response then do
     name=response
     match=1
     END
    if testname='' then iterate
    END
   END
END

OK:
SAY
if match=0 then
  DO
    SAY' I can''t find you on the users list!'
    SAY' You should log on to the BBS before you try this!'
    CALL delay(100)
    CALL bye
  END

userfile=bbspath'Users/'name
CALL open(data,userfile,'r')
DO i=1 TO 18
  line=readln(data)
  IF i=5 THEN password=WORD(line,1)
END
CALL close(data)
winnings=WORD(line,1)
IF ~DATATYPE(winnings,'N') THEN winnings=0

passprompt=' 'pen3'Please Enter Password: '
DO tries=1 TO 3
  OPTIONS PROMPT passprompt
  PULL newpassword
  SAY ''
  IF(password=newpassword) THEN LEAVE tries; /* correct password */
  IF tries=3 THEN
    DO
      SAY
      SAY 'Access terminated.'
      line='*** Bad password ***' newpassword '***'
      SAY line
      CALL bye
    END
  passprompt='Incorrect.  Password: ' /* ask again */
END
SAY
SAY' OK, 'name' here we go....'
SAY

CALL sortdoors()
temp=1
readcount=-1
DO doorloop=1
  IF temp=0 THEN
    DO
      IF readcount~=-1 THEN
        DO
          doors.0=''
          CALL sortdoors()
        END
      SAY
      SAY CENTER('- Number of accesses per file -',75)
    END
  SAY pen3||LEFT('-',75,'-')||def
  DO jd=1 TO jdoors.0
    IF temp=0 THEN SAY jdoors.jd.0
    ELSE SAY jdoors.jd
  END
  IF temp=0 THEN
    DO
      SAY
      OPTIONS PROMPT '                                 'pen3'Press RETURN 'def
      PULL junk
      temp=1
      SAY
      ITERATE doorloop
    END
  options prompt' 'pen3'Select Application Number (0=Stats) or hit 'pen2'Return to Quit' pen3'> 'def
  pull temp
  IF temp=0 THEN ITERATE doorloop
  IF ~DATATYPE(temp,'N') | temp<1 | temp>doors.0 THEN RETURN
  arg=doors.temp
  IF GETCLIP('BBS_door')=arg THEN
    DO
      SAY 'That door is in use!  Try again in a few minutes...'
      ITERATE doorloop
    END
  CALL SETCLIP('BBS_localdoor',arg)
  readcount=WORD(STATEF(bbspath'rexxDoors/'arg),8)
  IF ~DATATYPE(readcount,'W') THEN readcount=0
  ADDRESS COMMAND 'C:filenote' bbspath'rexxDoors/'arg readcount+1
  comm='CALL' doors.temp'('name winnings 0 1 6000')'
  INTERPRET comm
  CALL SETCLIP('BBS_localdoor')
END

bye:
CALL SETCLIP('BBS_localdoor')
SAY
SAY' Now leaving bbsDoors....'
SAY
EXIT


sortdoors:
IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  DO
    jdoors.=''
    doorlist=SHOWDIR(bbspath'rexxDoors','F')
    doors.=''
    doors.0=WORDS(doorlist)
    DO i=1 TO doors.0
      doors.i=WORD(doorlist,i)
    END
    SAY 'Sorting..'
    CALL QSORT(1,doors.0,doors)
    jdoors.0=doors.0%3
    IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
    DO i=1 TO jdoors.0
      DO j=0 TO 2
        k=i+j*jdoors.0
        IF k<=doors.0 THEN
          DO
            jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
            dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8)
            jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' '
          END
      END
    END
  END
RETURN 0


/* bbsDoors.rexx */